

<!DOCTYPE html>
<html lang="zh-CN" data-default-color-scheme=&#34;auto&#34;>



<head>
  <meta charset="UTF-8">
  <link rel="apple-touch-icon" sizes="76x76" href="/img/favicon.png">
  <link rel="icon" href="/img/favicon.png">
  <meta name="viewport"
        content="width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=no, shrink-to-fit=no">
  <meta http-equiv="x-ua-compatible" content="ie=edge">
  
  <meta name="theme-color" content="#2f4154">
  <meta name="description" content="沧海横流，尽显英雄本色；激浊扬清，正是猛士当时">
  <meta name="author" content="closer">
  <meta name="keywords" content="">
  
  <title>Excel_VBA - closer的自留地</title>

  <link  rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@4.5.3/dist/css/bootstrap.min.css" />


  <link  rel="stylesheet" href="https://cdn.jsdelivr.net/npm/github-markdown-css@4.0.0/github-markdown.min.css" />
  <link  rel="stylesheet" href="/lib/hint/hint.min.css" />

  
    
    
      
      <link  rel="stylesheet" href="https://cdn.jsdelivr.net/npm/highlight.js@10.6.0/styles/androidstudio.min.css" />
    
  

  
    <link  rel="stylesheet" href="https://cdn.jsdelivr.net/npm/@fancyapps/fancybox@3.5.7/dist/jquery.fancybox.min.css" />
  



<!-- 主题依赖的图标库，不要自行修改 -->

<link rel="stylesheet" href="//at.alicdn.com/t/font_1749284_ba1fz6golrf.css">



<link rel="stylesheet" href="//at.alicdn.com/t/font_1736178_kmeydafke9r.css">


<link  rel="stylesheet" href="/css/main.css" />

<!-- 自定义样式保持在最底部 -->


  <script id="fluid-configs">
    var Fluid = window.Fluid || {};
    var CONFIG = {"hostname":"blog.zsaa.top","root":"/","version":"1.8.10","typing":{"enable":true,"typeSpeed":70,"cursorChar":"_","loop":false},"anchorjs":{"enable":true,"element":"h1,h2,h3,h4,h5,h6","placement":"right","visible":"always","icon":""},"progressbar":{"enable":true,"height_px":3,"color":"#29d","options":{"showSpinner":false,"trickleSpeed":100}},"copy_btn":true,"image_zoom":{"enable":true,"img_url_replace":["",""]},"toc":{"enable":true,"headingSelector":"h1,h2,h3,h4,h5,h6","collapseDepth":0},"lazyload":{"enable":true,"loading_img":"/img/loading.gif","onlypost":false,"offset_factor":2},"web_analytics":{"enable":true,"baidu":"608f2baddd361128381ad2bf9377bf89","google":null,"gtag":null,"tencent":{"sid":null,"cid":null},"woyaola":null,"cnzz":null,"leancloud":{"app_id":"YzLqNtMw1YEwwACli1FUsIUM-gzGzoHsz","app_key":"HLUt5izfTvTcbEbOrA59W92a","server_url":"https://yzlqntmw.lc-cn-n1-shared.com"}}};
  </script>
  <script  src="/js/utils.js" ></script>
  <script  src="/js/color-schema.js" ></script>
<meta name="generator" content="Hexo 5.4.0"></head>


<body>
  <header style="height: 70vh;">
    <nav id="navbar" class="navbar fixed-top  navbar-expand-lg navbar-dark scrolling-navbar">
  <div class="container">
    <a class="navbar-brand"
       href="/">&nbsp;<strong>Hello</strong>&nbsp;</a>

    <button id="navbar-toggler-btn" class="navbar-toggler" type="button" data-toggle="collapse"
            data-target="#navbarSupportedContent"
            aria-controls="navbarSupportedContent" aria-expanded="false" aria-label="Toggle navigation">
      <div class="animated-icon"><span></span><span></span><span></span></div>
    </button>

    <!-- Collapsible content -->
    <div class="collapse navbar-collapse" id="navbarSupportedContent">
      <ul class="navbar-nav ml-auto text-center">
        
          
          
          
          
            <li class="nav-item">
              <a class="nav-link" href="/">
                <i class="iconfont icon-home-fill"></i>
                首页
              </a>
            </li>
          
        
          
          
          
          
            <li class="nav-item">
              <a class="nav-link" href="/archives/">
                <i class="iconfont icon-archive-fill"></i>
                归档
              </a>
            </li>
          
        
          
          
          
          
            <li class="nav-item">
              <a class="nav-link" href="/categories/">
                <i class="iconfont icon-category-fill"></i>
                分类
              </a>
            </li>
          
        
          
          
          
          
            <li class="nav-item">
              <a class="nav-link" href="/tags/">
                <i class="iconfont icon-tags-fill"></i>
                标签
              </a>
            </li>
          
        
          
          
          
          
            <li class="nav-item">
              <a class="nav-link" href="/about/">
                <i class="iconfont icon-user-fill"></i>
                关于
              </a>
            </li>
          
        
          
          
          
          
            <li class="nav-item">
              <a class="nav-link" href="/links/">
                <i class="iconfont icon-link-fill"></i>
                友链
              </a>
            </li>
          
        
        
          <li class="nav-item" id="search-btn">
            <a class="nav-link" target="_self" data-toggle="modal" data-target="#modalSearch">&nbsp;<i
                class="iconfont icon-search"></i>&nbsp;</a>
          </li>
        
        
          <li class="nav-item" id="color-toggle-btn">
            <a class="nav-link" target="_self">&nbsp;<i
                class="iconfont icon-dark" id="color-toggle-icon"></i>&nbsp;</a>
          </li>
        
      </ul>
    </div>
  </div>
</nav>

    <div class="banner" id="banner" parallax=true
         style="background: url('/img/mydefault.jpg') no-repeat center center;
           background-size: cover;">
      <div class="full-bg-img">
        <div class="mask flex-center" style="background-color: rgba(0, 0, 0, 0.3)">
          <div class="page-header text-center fade-in-up">
            <span class="h2" id="subtitle" title="Excel_VBA">
              
            </span>

            
              <div class="mt-3">
  
  
    <span class="post-meta">
      <i class="iconfont icon-date-fill" aria-hidden="true"></i>
      <time datetime="2021-02-03 19:39" pubdate>
        2021年2月3日 晚上
      </time>
    </span>
  
</div>

<div class="mt-1">
  
    
    <span class="post-meta mr-2">
      <i class="iconfont icon-chart"></i>
      5.6k 字
    </span>
  

  
    
    <span class="post-meta mr-2">
      <i class="iconfont icon-clock-fill"></i>
      
      
      82
       分钟
    </span>
  

  
  
    
      <!-- LeanCloud 统计文章PV -->
      <span id="leancloud-page-views-container" class="post-meta" style="display: none">
        <i class="iconfont icon-eye" aria-hidden="true"></i>
        <span id="leancloud-page-views"></span> 次
      </span>
    
  
</div>

            
          </div>

          
        </div>
      </div>
    </div>
  </header>

  <main>
    
      

<div class="container-fluid nopadding-x">
  <div class="row nomargin-x">
    <div class="d-none d-lg-block col-lg-2"></div>
    <div class="col-lg-8 nopadding-x-md">
      <div class="container nopadding-x-md" id="board-ctn">
        <div class="py-5" id="board">
          <article class="post-content mx-auto">
            <!-- SEO header -->
            <h1 style="display: none">Excel_VBA</h1>
            
              <p class="note note-info">
                
                  本文最后更新于：2021年11月1日 下午
                
              </p>
            
            <div class="markdown-body">
              <blockquote>
<p>本教程自用，也适合有一点编程基础的人查阅。<a target="_blank" rel="noopener" href="https://www.lanzous.com/i96y7sj">课件地址</a></p>
</blockquote>
<h2 id="一：-基础"><a href="#一：-基础" class="headerlink" title="一： 基础"></a>一： 基础</h2><h3 id="1-1-If-And-For"><a href="#1-1-If-And-For" class="headerlink" title="1.1 If And For"></a>1.1 If And For</h3><p>利用if和for来制作工资条和恢复工资表。</p>
<p>PS：插入会导致行序号变化，可以从表尾插入，就不会导致下面的行序号变化了。<br>删除表或区域也一样，最好倒着删。<br>如：<code>For i = 100 To 1 Step -1</code>。</p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br><span class="line">19</span><br><span class="line">20</span><br><span class="line">21</span><br><span class="line">22</span><br><span class="line">23</span><br><span class="line">24</span><br><span class="line">25</span><br><span class="line">26</span><br><span class="line">27</span><br><span class="line">28</span><br><span class="line">29</span><br><span class="line">30</span><br><span class="line">31</span><br><span class="line">32</span><br><span class="line">33</span><br><span class="line">34</span><br><span class="line">35</span><br><span class="line">36</span><br><span class="line">37</span><br><span class="line">38</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 制作工资条()<br>Dim i As Integer<br><br>&#x27; 从第3行起，每隔一行插入第一行表头<br>For i = 3 To 200 Step 2<br>    &#x27; 如果i行为空，则跳出循环，Range是单元格<br>    If Range(&quot;A&quot; &amp; i) = &quot;&quot; Then<br>        Exit For<br>    End If<br>    <br>    &#x27; 选择第一行，复制，Rows是行<br>    Rows(&quot;1:1&quot;).Select<br>    Application.CutCopyMode = False<br>    Selection.Copy<br>    &#x27; 选中第i行，插入复制的表头<br>    Range(&quot;A&quot; &amp; i).Select<br>    Selection.Insert shift:=xlDown<br>    <br>Next<br>End Sub<br><br><br>Sub 恢复工资表()<br>Dim i As Integer<br><br>&#x27; 从第3行起，递归删除下一行<br>For i = 3 To 200<br>    &#x27; 如果i行为空，则跳出循环<br>    If Range(&quot;A&quot; &amp; i) = &quot;&quot; Then<br>        Exit For<br>    End If<br>    <br>    Range(&quot;A&quot; &amp; i).Select<br>    Application.CutCopyMode = False<br>    Selection.EntireRow.Delete<br><br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h3 id="1-2-操作工作表"><a href="#1-2-操作工作表" class="headerlink" title="1.2 操作工作表"></a>1.2 操作工作表</h3><h4 id="1-2-1-Add"><a href="#1-2-1-Add" class="headerlink" title="1.2.1 Add"></a>1.2.1 Add</h4><p><code>Sheets(Sheets.Count)</code>获取最后一张表</p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 建12个月的表()<br>Dim i As Integer<br><br>For i = 1 To 12<br>    &#x27; 在最后一张表后面新建一张表<br>    Sheets.Add after:=Sheets(Sheets.Count)<br>    &#x27; 最后一张表命名为i月<br>    Sheets(Sheets.Count).Name = i &amp; &quot;月&quot;<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="1-2-2-Delete"><a href="#1-2-2-Delete" class="headerlink" title="1.2.2 Delete"></a>1.2.2 Delete</h4><p>删除表记得加上取消提示框和恢复提示框。</p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 删除12个月的表()<br>Dim i As Integer<br><br>&#x27;取消提示框<br>Excel.Application.DisplayAlerts = False<br><br>For i = 1 To 12<br>    &#x27; 删除第一张，后面表就变为sheets(1)<br>    Sheets(2).Delete<br>Next<br><br>&#x27; 恢复提示框<br>Excel.Application.DisplayAlerts = True<br><br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="1-2-3-Copy"><a href="#1-2-3-Copy" class="headerlink" title="1.2.3 Copy"></a>1.2.3 Copy</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 复制表()<br>Sheets(1).Copy after:=Sheets(Sheets.Count)<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="1-2-4-模板创建日报表"><a href="#1-2-4-模板创建日报表" class="headerlink" title="1.2.4 模板创建日报表"></a>1.2.4 模板创建日报表</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 模板创建31天日报表()<br>Dim i As Integer<br><br>For i = 1 To 31<br>    &#x27; 复制第一张表<br>    Sheets(1).Copy after:=Sheets(Sheets.Count)<br>    &#x27; 最后一张表命名为5月i日<br>    Sheets(Sheets.Count).Name = &quot;5月&quot; &amp; i &amp; &quot;日&quot;<br>    &#x27; 表内的e5单元格赋予内容<br>    Sheets(Sheets.Count).Range(&quot;e5&quot;) = &quot;2016-5-&quot; &amp; i<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="1-2-5-多表汇总"><a href="#1-2-5-多表汇总" class="headerlink" title="1.2.5 多表汇总"></a>1.2.5 多表汇总</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 多表汇总()<br>Dim i As Integer<br>&#x27; 把第一张表的B列设为日期<br>Columns(&quot;B:B&quot;).Select<br>Selection.NumberFormatLocal = &quot;yyyy-m-d&quot;<br><br>&#x27; 从第二张表开始汇总<br>For i = 2 To Sheets.Count<br>    &#x27; 把下表的e5内容存到表1的b10单元格内<br>    Sheets(1).Range(&quot;b&quot; &amp; i + 8) = Sheets(i).Range(&quot;e5&quot;)<br>    Sheets(1).Range(&quot;c&quot; &amp; i + 8) = Sheets(i).Range(&quot;e6&quot;)<br>    Sheets(1).Range(&quot;d&quot; &amp; i + 8) = Sheets(i).Range(&quot;e44&quot;)<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h3 id="1-3-操作工作簿"><a href="#1-3-操作工作簿" class="headerlink" title="1.3 操作工作簿"></a>1.3 操作工作簿</h3><h4 id="1-3-1-For-Each"><a href="#1-3-1-For-Each" class="headerlink" title="1.3.1 For Each"></a>1.3.1 For Each</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 删除工作簿()<br>Dim 表 As Worksheet<br>&#x27; 不提示警告框<br>Application.DisplayAlerts = False<br>For Each 表 In Sheets<br>    If 表.Name &lt;&gt; &quot;决不能删&quot; Then<br>        表.Delete<br>    End If<br>Next<br>Application.DisplayAlerts = True<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="1-3-2-操作文件"><a href="#1-3-2-操作文件" class="headerlink" title="1.3.2 操作文件"></a>1.3.2 操作文件</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br><span class="line">19</span><br><span class="line">20</span><br><span class="line">21</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 操作文件()<br>&#x27; 关闭屏幕更新，即操作文件时不闪现文件<br>Application.ScreenUpdating = False<br>Application.DisplayAlerts = False<br>&#x27; 新建工作簿<br>Workbooks.Add<br>&#x27; 活动工作簿的第一张表的a2格写入这是我自动创建的<br>ActiveWorkbook.Sheets(1).Range(&quot;a2&quot;) = &quot;这是我自动创建的&quot;<br>&#x27; 活动工作簿另存为d:\temp\1.xlsx<br>ActiveWorkbook.SaveAs Filename:=&quot;d:\temp\1.xlsx&quot;<br>&#x27; 关闭工作簿<br>ActiveWorkbook.Close<br>&#x27; 打开文件d:\temp\1.xlsx<br>Workbooks.Open Filename:=&quot;d:\temp\1.xlsx&quot;<br>&#x27; 活动工作簿的第一张表的a1格写入到此一游<br>ActiveWorkbook.Sheets(1).Range(&quot;a1&quot;) = &quot;到此一游&quot;<br>ActiveWorkbook.Save<br>ActiveWorkbook.Close<br>Application.ScreenUpdating = True<br>Application.DisplayAlerts = True<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="1-3-3-将多个表拆分并另存为多个工作簿"><a href="#1-3-3-将多个表拆分并另存为多个工作簿" class="headerlink" title="1.3.3 将多个表拆分并另存为多个工作簿"></a>1.3.3 将多个表拆分并另存为多个工作簿</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 将多个表拆分并另存为多个工作簿()<br>Dim sht As Worksheet<br>&#x27; 遍历每一张表<br>For Each sht In Sheets<br>    &#x27; 表.copy默认复制当前活动表并新建为一个新工作簿的新表<br>    sht.Copy<br>    &#x27; 文件名保存为表名<br>    ActiveWorkbook.SaveAs Filename:=&quot;d:\temp\&quot; &amp; sht.Name &amp; &quot;.xlsx&quot;<br>    ActiveWorkbook.Close<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h3 id="1-4-操作单元格对象"><a href="#1-4-操作单元格对象" class="headerlink" title="1.4 操作单元格对象"></a>1.4 操作单元格对象</h3><p>基本函数说明：</p>
<ol>
<li><code>Cells(10,2)</code> 等同于 <code>B10</code>单元格 等同于 <code>Range(&quot;b10&quot;)</code></li>
<li><code>Range(&quot;a1&quot;).Offset(5,1)</code> 等同于取 <code>a1</code> 单元格下5行、右1列，即 <code>b6</code></li>
<li><code>Range(&quot;a100&quot;).End(xlUp)</code> 等同于取 <code>A</code>列<strong>从下往上</strong>第一个有数据的单元格(若<code>a100</code>本身有数据，则取<code>a100</code>从下往上最后第一个有数据的单元格)</li>
<li><code>Range(&quot;a10&quot;).EntireRow.Select</code> 等同于选中<code>a10</code>所在单元格那一行</li>
<li><code>Range(&quot;a2&quot;).Resize(2, 3).Select</code> 等同于选中<code>a2:c3</code>，即选中2行、3列</li>
<li><code>Range(&quot;a1&quot;).Copy Range(&quot;b1&quot;)</code> 等同于把<code>a1</code>单元格复制到<code>b1</code>单元格</li>
</ol>
<h4 id="1-4-1-实际应用1"><a href="#1-4-1-实际应用1" class="headerlink" title="1.4.1 实际应用1"></a>1.4.1 实际应用1</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 合并单元格()<br>Dim rng As Range<br>&#x27; 合并a1、a2；b1、b2；c1、c2单元格<br>For Each rng In Range(&quot;a1:c1&quot;)<br>    rng.Resize(2, 1).Merge<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 自动填充()<br>&#x27; 定义rng为单元格格式<br>Dim rng As Range<br>&#x27; 遍历b2到a列最后一个不为空的单元格的那一行<br>For Each rng In Range(&quot;b2:b&quot; &amp; Range(&quot;a65535&quot;).End(xlUp).Row)<br>    &#x27; 若本单元格左边的一格内为男，则本单元格的值为先生<br>    If rng.Offset(0, -1) = &quot;男&quot; Then<br>        rng.Value = &quot;先生&quot;<br>    Else<br>        rng.Value = &quot;0&quot;<br>    End If<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br><span class="line">19</span><br><span class="line">20</span><br><span class="line">21</span><br><span class="line">22</span><br><span class="line">23</span><br><span class="line">24</span><br><span class="line">25</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 清空内容()<br>For i = 2 To Sheets.Count<br>    &#x27; 清除内容不清除格式<br>    Sheets(i).Range(&quot;a2:z10000&quot;).ClearContents<br>Next<br>End Sub<br><br>Sub 拆分表初版()<br>Dim i, j, k As Integer<br>&#x27; 调用函数 清空内容()<br>Call 清空内容<br>&#x27; 遍历所有工作表<br>For i = 2 To Sheets.Count<br>    &#x27; 遍历表1的第二行到最后一行<br>    For j = 2 To Sheet1.Range(&quot;a65535&quot;).End(xlUp).Row<br>        &#x27; 若表1的d列值等于表i的名字<br>        If Sheet1.Range(&quot;d&quot; &amp; j) = Sheets(i).Name Then<br>            &#x27; 表i的单元格最后一行有数据的行号为k<br>            k = Sheets(i).Range(&quot;a65535&quot;).End(xlUp).Row<br>            &#x27; 表1的第j行整行复制到表i的k行的下一行<br>            Sheet1.Range(&quot;d&quot; &amp; j).EntireRow.Copy Sheets(i).Range(&quot;a&quot; &amp; k + 1)<br>        End If<br>    Next<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="1-4-2-一张表拆分为多张表"><a href="#1-4-2-一张表拆分为多张表" class="headerlink" title="1.4.2 一张表拆分为多张表"></a>1.4.2 一张表拆分为多张表</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 用筛选来拆分表()<br>Dim i As Integer<br>For i = 2 To Sheets.Count<br>    &#x27; 表1的所有行，筛选出第4列D，数据为表名。PS：Criteria1后面是a一<br>    Sheets(1).Range(&quot;a1:f1048&quot;).AutoFilter Field:=4, Criteria1:=Sheets(i).Name<br>    &#x27; 筛选出的表1的所有单元格复制到对应表<br>    Sheet1.Range(&quot;a1:f1048&quot;).Copy Sheets(i).Range(&quot;a1&quot;)<br>Next<br>&#x27; 关闭筛选<br>Sheet1.Range(&quot;a1:f1048&quot;).AutoFilter<br>End Sub<br></code></pre></div></td></tr></table></figure>

<p>基本函数：</p>
<ol>
<li><code>MsgBox &quot;我是弹窗！&quot;</code> 弹出提示框</li>
<li><code>InputBox &quot;你多大了？&quot;</code> 弹出输入框</li>
</ol>
<p><strong>应用：将一张表的指定列的所有不同的数据拆分为不同的表。</strong></p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br><span class="line">19</span><br><span class="line">20</span><br><span class="line">21</span><br><span class="line">22</span><br><span class="line">23</span><br><span class="line">24</span><br><span class="line">25</span><br><span class="line">26</span><br><span class="line">27</span><br><span class="line">28</span><br><span class="line">29</span><br><span class="line">30</span><br><span class="line">31</span><br><span class="line">32</span><br><span class="line">33</span><br><span class="line">34</span><br><span class="line">35</span><br><span class="line">36</span><br><span class="line">37</span><br><span class="line">38</span><br><span class="line">39</span><br><span class="line">40</span><br><span class="line">41</span><br><span class="line">42</span><br><span class="line">43</span><br><span class="line">44</span><br><span class="line">45</span><br><span class="line">46</span><br><span class="line">47</span><br><span class="line">48</span><br><span class="line">49</span><br><span class="line">50</span><br><span class="line">51</span><br><span class="line">52</span><br><span class="line">53</span><br><span class="line">54</span><br><span class="line">55</span><br><span class="line">56</span><br><span class="line">57</span><br><span class="line">58</span><br><span class="line">59</span><br><span class="line">60</span><br><span class="line">61</span><br><span class="line">62</span><br><span class="line">63</span><br><span class="line">64</span><br><span class="line">65</span><br><span class="line">66</span><br><span class="line">67</span><br><span class="line">68</span><br><span class="line">69</span><br><span class="line">70</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 未重名则新建表(列, sht0)<br>Dim sht As Worksheet<br>&#x27; 默认k=0<br>Dim i, k As Integer<br>Dim irow As Integer &#x27; irow为共多少行<br>irow = sht0.Range(&quot;a65536&quot;).End(xlUp).Row<br>For i = 2 To irow<br>    k = 0<br>    For Each sht In Sheets<br>        &#x27; 遍历表，如果表重名，则k=1，那么不新建<br>        If sht.Name = sht0.Cells(i, 列) Then<br>            k = 1<br>        End If<br>    Next<br>    If k = 0 Then &#x27; 没重名<br>        &#x27; 在最后一张表后面新建表并定义表名<br>         Sheets.Add(after:=Sheets(Sheets.Count)).Name = sht0.Cells(i, 列)<br>    End If<br>Next<br>End Sub<br><br><br>Sub 拷贝数据(列, sht0)<br>Dim i As Integer<br>Dim irow As Integer &#x27; irow为共多少行<br>irow = sht0.Range(&quot;a65536&quot;).End(xlUp).Row<br>Call 未重名则新建表(列, sht0)<br>For i = 2 To Sheets.Count<br>    &#x27; 表1的所有行，筛选出第4列D，数据为表名。PS：Criteria1后面是a一<br>    sht0.Range(&quot;a1:z&quot; &amp; irow).AutoFilter Field:=列, Criteria1:=Sheets(i).Name<br>    &#x27; 筛选出的表1的所有行复制到对应表<br>    sht0.Range(&quot;a1:z&quot; &amp; irow).Copy Sheets(i).Range(&quot;a1&quot;)<br>Next<br>&#x27; 关闭筛选<br>sht0.Range(&quot;a1:z&quot; &amp; irow).AutoFilter<br>End Sub<br><br><br>Sub 拆分数据表完成版()<br>Dim sht, sht0 As Worksheet<br>&#x27; 将一张表的指定列的所有不同的数据拆分为不同的表<br>Dim i<br>i = InputBox(&quot;此操作会删除除第一张表外的所有表，如不需要请关闭。那么请问你要拆分第几列(输入数字)？&quot;)<br><br>&#x27; 如果i不是数字或不在范围内，则终止，防止出错<br>If IsNumeric(i) = False Or i &lt; 1 Or i &gt; 20 Then<br>    MsgBox (&quot;请输入正确的数字，如4。&quot;)<br>    Exit Sub<br>End If<br><br>&#x27; 将i转换为整型<br>i = Val(i)<br><br>&#x27; 先备份当前活动表数据到sht0，防止误删<br>Set sht0 = ActiveSheet<br><br>Application.DisplayAlerts = False &#x27;关闭提示<br>&#x27; 删除除了第一张表外的所有表<br>If Sheets.Count &gt; 1 Then<br>    For Each sht In Sheets<br>        If sht.Name &lt;&gt; sht0.Name Then<br>            sht.Delete<br>        End If<br>    Next<br>End If<br><br>Call 拷贝数据(i, sht0)<br>Application.DisplayAlerts = True &#x27;打开提示<br>sht0.Select<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h3 id="1-5-事件与典型应用案例"><a href="#1-5-事件与典型应用案例" class="headerlink" title="1.5 事件与典型应用案例"></a>1.5 事件与典型应用案例</h3><h4 id="1-5-1-With与选项卡"><a href="#1-5-1-With与选项卡" class="headerlink" title="1.5.1 With与选项卡"></a>1.5.1 With与选项卡</h4><p>With可以用于设置单元格格式。</p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">&#x27; 对齐方式选项卡<br>With Selection<br>        .HorizontalAlignment = xlRight  &#x27;水平对齐方式<br>        .VerticalAlignment = xlCenter   &#x27;垂直对齐方式<br>        .WrapText = False               &#x27;自动换行<br>        .Orientation = 0                &#x27;文字方向<br>        .AddIndent = False              &#x27;缩进<br>        .IndentLevel = 0                &#x27;缩进量<br>        .ShrinkToFit = False            &#x27;缩小字体填充<br>        .ReadingOrder = xlContext       &#x27;文字方向<br>        .MergeCells = False             &#x27;合并单元格<br>    End With<br></code></pre></div></td></tr></table></figure>

<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">&#x27; 字体格式选项卡<br> With Selection.Font<br>        .Name = &quot;华文琥珀&quot;                  &#x27;字体<br>        .Size = 9                           &#x27;字号<br>        .Strikethrough = False              &#x27;删除线<br>        .Superscript = False                &#x27;上标<br>        .Subscript = False                  &#x27;下标<br>        .OutlineFont = False                &#x27;大纲字体<br>        .Shadow = False                     &#x27;阴影<br>        .Underline = xlUnderlineStyleNone   &#x27;下划线<br>        .ColorIndex = xlAutomatic           &#x27;字体颜色<br>        .TintAndShade = 0                   &#x27;颜色变深或变浅<br>        .ThemeFont = xlThemeFontNone        &#x27;主题字体<br>    End With<br></code></pre></div></td></tr></table></figure>

<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">&#x27; 填充色选项卡<br> With Selection.Interior<br>        .Pattern = xlSolid                      &#x27;图案样式<br>        .PatternColorIndex = xlAutomatic        &#x27;图案颜色<br>        .ThemeColor = xlThemeColorDark1         &#x27;主体颜色<br>        .TintAndShade = -4.99893185216834E-02   &#x27;颜色变深或变浅<br>        .Color = 65535                          &#x27;填充色<br>        .PatternTintAndShade = 0                &#x27;对象的淡色和底纹图案<br>    End With<br></code></pre></div></td></tr></table></figure>

<h4 id="1-5-2-事件"><a href="#1-5-2-事件" class="headerlink" title="1.5.2 事件"></a>1.5.2 事件</h4><p>在VBA中，要手动更改单元格或单元格值范围时，可以触发事件驱动的编程。<a target="_blank" rel="noopener" href="https://yiibai.com/vba/vba_events.html">点击查看如何触发事件</a></p>
<p><strong>常见的事件如下：</strong></p>
<p>工作簿事件|说明<br>|-|-|<br>Activate|激活工作薄时<br>AddinInstall|当工作簿作为加载宏安装时<br>AddinUninstall|工作簿作为加载宏卸载时<br>BeforeClose|关闭工作薄前<br>BeforePrint|打印工作薄（或其中任何内容）之前<br>BeforeSave|保存工作薄前<br>Deactivate|工作簿从活动状态转为非活动状态时<br>NewSheet|在工作簿中新建工作表时<br>Open|打开工作簿时<br>PivotTableCloseConnection|在数据透视表关闭与其数据源的连接之后<br>PivotTableOpenConnection|在数据透视表打开与其数据源的连接之后<br>SheetActivate|激活任何一张表时<br>SheetBeforeDoubleClick|双击任何工作表时<br>SheetBeforeRightClick|鼠标右键单击任一工作表时<br>SheetCalculate|工作表重新计算时<br>SheetChange|更改工作表中的单元格时<br>SheetDeactivate|任一工作表由活动状态转为非活动状态时<br>SheetFollowHyperlink|单击 Microsoft Excel中的任意超链接时<br>SheetPivotTableUpdate|数据透视表的工作表更新之后<br>SheetSelectionChange|工作簿中的数据透视表更新之后<br>WindowActivate|工作簿的窗口激活时<br>WindowDeactivate|工作簿的窗口变为非活动状态时<br>WindowResize|工作簿窗口调整大小时</p>
<hr>
<table>
<thead>
<tr>
<th>工作表事件</th>
<th>说明</th>
</tr>
</thead>
<tbody><tr>
<td>Activate</td>
<td>激活工作表时</td>
</tr>
<tr>
<td>Deactivate</td>
<td>工作表从活动状态转为非活动状态时</td>
</tr>
<tr>
<td>BeforeDoubleClick</td>
<td>双击工作表前</td>
</tr>
<tr>
<td>BeforeRightClick</td>
<td>右键单击工作表时</td>
</tr>
<tr>
<td>Calculate</td>
<td>对工作表进行重新计算之后</td>
</tr>
<tr>
<td>Change</td>
<td>更改工作表中的单元格，或外部链接引起单元格变化时</td>
</tr>
<tr>
<td>FollowHyperlink</td>
<td>单击工作表上的任意超链接时</td>
</tr>
<tr>
<td>PivotTableUpdate</td>
<td>在工作簿中的数据透视表更新之后</td>
</tr>
<tr>
<td>SelectionChange</td>
<td>工作表上的选定区域发生改变时</td>
</tr>
</tbody></table>
<hr>
<h4 id="1-5-3-聚光灯、自动筛选、自动备份"><a href="#1-5-3-聚光灯、自动筛选、自动备份" class="headerlink" title="1.5.3 聚光灯、自动筛选、自动备份"></a>1.5.3 聚光灯、自动筛选、自动备份</h4><p><strong>聚光灯效果。</strong></p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">&#x27; 在sheet1事件SelectionChange里输入如下代码<br>Private Sub Worksheet_SelectionChange(ByVal Target As Range)<br>Call 聚光灯<br>End Sub<br><br>Sub 聚光灯()<br>&#x27; 整表无填充色<br>Cells.Interior.Pattern = xlNone<br>&#x27; 选中的单元格所在行改为黄色<br>Selection.EntireRow.Interior.Color = 65535<br>End Sub<br></code></pre></div></td></tr></table></figure>

<p><strong>自动筛选。</strong></p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Private Sub Worksheet_Change(ByVal Target As Range)<br>&#x27; 关闭事件触发。事件里一般都要加上，否则一change就触发，会死机<br>Application.EnableEvents = False<br>Call 输入条件自动完成筛选<br>&#x27; 打开事件触发<br>Application.EnableEvents = True<br>End Sub<br><br>Sub 输入条件自动完成筛选()<br>&#x27;清除掉L列及往后的数据<br>Sheets(1).Range(&quot;L1:Q&quot; &amp; Sheets(1).Range(&quot;a65536&quot;).End(xlUp).Row).Clear<br>&#x27; 筛选表1的第4列，关键词为i2的值<br>Sheets(1).Range(&quot;a1:f&quot; &amp; Sheets(1).Range(&quot;a65536&quot;).End(xlUp).Row).AutoFilter Field:=4, Criteria1:=Range(&quot;i2&quot;)<br>Sheets(1).Range(&quot;a1:f&quot; &amp; Sheets(1).Range(&quot;a65536&quot;).End(xlUp).Row).Copy Range(&quot;L1&quot;)<br>&#x27; 关闭筛选<br>Sheets(1).Range(&quot;a1:f&quot; &amp; Sheets(1).Range(&quot;a65536&quot;).End(xlUp).Row).AutoFilter<br>End Sub<br></code></pre></div></td></tr></table></figure>

<p><strong>自动备份。</strong></p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">&#x27; 在工作薄触发事件中<br>Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)<br>&#x27; Format把日期时间数据转换成一个字符串<br>ThisWorkbook.SaveCopyAs &quot;d:\temp\&quot; &amp; Format(Now(), &quot;yyyymmddhhmmss&quot;) &amp; &quot;.xls&quot;<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h3 id="1-6-VBA中使用公式"><a href="#1-6-VBA中使用公式" class="headerlink" title="1.6 VBA中使用公式"></a>1.6 VBA中使用公式</h3><h4 id="1-6-1-统计人数"><a href="#1-6-1-统计人数" class="headerlink" title="1.6.1 统计人数"></a>1.6.1 统计人数</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 统计人数()<br>Dim i, k, l, m As Integer<br>&#x27; 遍历工作表<br>For i = 2 To Sheets.Count<br>    &#x27; 统计所有工作表中A列中有数据的个数<br>    k = k + Application.WorksheetFunction.CountA(Sheets(i).Range(&quot;a:a&quot;)) - 1<br>    &#x27; 统计所有表中F列为“男”的个数<br>    l = l + Application.WorksheetFunction.CountIf(Sheets(i).Range(&quot;f:f&quot;), &quot;男&quot;)<br>    m = m + Application.WorksheetFunction.CountIf(Sheets(i).Range(&quot;f:f&quot;), &quot;女&quot;)<br>Next<br><br>Sheets(1).Range(&quot;d26&quot;) = k<br>Sheets(1).Range(&quot;d27&quot;) = l<br>Sheets(1).Range(&quot;d28&quot;) = m<br><br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="1-6-2-跨表查询"><a href="#1-6-2-跨表查询" class="headerlink" title="1.6.2 跨表查询"></a>1.6.2 跨表查询</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br><span class="line">19</span><br><span class="line">20</span><br><span class="line">21</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 跨表查询数据()<br>&#x27; 运行错误，则继续执行出错语句的下面的那句<br>On Error Resume Next<br><br>&#x27; 清除d14的姓名数据<br>Sheets(1).Range(&quot;d14&quot;).ClearContents<br><br>Dim i As Integer<br>For i = 2 To Sheets.Count<br>    Sheets(1).Range(&quot;d14&quot;) = Application.WorksheetFunction.VLookup(Sheets(1).Range(&quot;d9&quot;), Sheets(i).Range(&quot;a:h&quot;), 5, 0)<br>    Sheets(1).Range(&quot;d16&quot;) = Application.WorksheetFunction.VLookup(Sheets(1).Range(&quot;d9&quot;), Sheets(i).Range(&quot;a:h&quot;), 6, 0)<br>    Sheets(1).Range(&quot;d18&quot;) = Application.WorksheetFunction.VLookup(Sheets(1).Range(&quot;d9&quot;), Sheets(i).Range(&quot;a:h&quot;), 3, 0)<br>    Sheets(1).Range(&quot;d20&quot;) = Application.WorksheetFunction.VLookup(Sheets(1).Range(&quot;d9&quot;), Sheets(i).Range(&quot;a:h&quot;), 8, 0)<br>    Sheets(1).Range(&quot;d22&quot;) = Sheets(i).Name<br>    &#x27; 如果查询到数据，则跳出循环<br>    If Sheets(1).Range(&quot;d14&quot;) &lt;&gt; &quot;&quot; Then<br>        Exit For<br>    End If<br>Next<br><br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="1-6-3-Instr-和-Split"><a href="#1-6-3-Instr-和-Split" class="headerlink" title="1.6.3 Instr 和 Split"></a>1.6.3 Instr 和 Split</h4><p>Instr用于寻找指定字符；<br>Split用于切片字符串，分割为字符数组。</p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 寻找字符()<br>&#x27; 寻找@字符<br>Range(&quot;a1&quot;).Value = VBA.Strings.InStr(Range(&quot;a2&quot;), &quot;@&quot;)<br>End Sub<br><br><br>Sub 切片()<br>&#x27; 通过指定分隔符，把一个字符串分割成字符串数组，下标从0开始<br>Range(&quot;b2&quot;) = Split(Range(&quot;a2&quot;), &quot;-&quot;)(1)<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="1-6-4-常用的几类VBA函数"><a href="#1-6-4-常用的几类VBA函数" class="headerlink" title="1.6.4 常用的几类VBA函数"></a>1.6.4 常用的几类VBA函数</h4><p><code>With VBA</code><br>函数|说明<br>-|-<br>.Strings|文本函数<br>.Math|数学函数<br>.DateTime|日期时间<br>.FileSystem|文件信息<br>.Financial|财务函数<br>.Information|信息函数<br>.Interaction|交互函数<br><code>End With</code></p>
<hr>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 转换日期()<br>&#x27; 将20200102转换为2020-01-02<br>With Sheets(1)<br>    For i = 2 To .Range(&quot;a65536&quot;).End(xlUp).Row<br>        &#x27; DateSerial函数返回包含指定的年、月、日的变量<br>        .Range(&quot;b&quot; &amp; i) = DateSerial(Left(.Range(&quot;a&quot; &amp; i), 4), Mid(.Range(&quot;a&quot; &amp; i), 5, 2), Right(.Range(&quot;a&quot; &amp; i), 2))<br>    Next<br>End With<br>End Sub<br><br><br>Sub 身份证号提取生日()<br>With Sheets(2)<br>    For i = 2 To .Range(&quot;a65536&quot;).End(xlUp).Row<br>        .Range(&quot;b&quot; &amp; i) = DateSerial(Mid(.Range(&quot;a&quot; &amp; i), 7, 4), Mid(.Range(&quot;a&quot; &amp; i), 11, 2), Mid(.Range(&quot;a&quot; &amp; i), 13, 2))<br>    Next<br>End With<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h3 id="1-7-其他"><a href="#1-7-其他" class="headerlink" title="1.7 其他"></a>1.7 其他</h3><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 批量创建文件夹()<br>On Error Resume Next<br>Dim path As String<br>&#x27; //路径是当前文件所在路径的temp文件夹下<br>myPath = ThisWorkbook.path &amp; &quot;\temp\&quot;<br>If Dir(myPath) = &quot;&quot; Then         &#x27;// 文件夹不存在就建立<br>    MkDir mypath<br>End If<br>For i = 1 To Range(&quot;A65536&quot;).End(xlUp).Row<br>    myFilename = myPath &amp; Range(&quot;A&quot; &amp; i).Value  &#x27;//A列<br>    If Dir(Name) = &quot;&quot; Then          &#x27;// 文件夹不存在就建立<br>        VBA.MkDir (myFilename)<br>    End If<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h2 id="二：-进阶"><a href="#二：-进阶" class="headerlink" title="二： 进阶"></a>二： 进阶</h2><h3 id="2-1-函数和过程"><a href="#2-1-函数和过程" class="headerlink" title="2.1 函数和过程"></a>2.1 函数和过程</h3><p>函数有返回值，过程可以无返回值。VBA中直接函数名=返回值。</p>
<h4 id="2-1-1-简单的函数"><a href="#2-1-1-简单的函数" class="headerlink" title="2.1.1 简单的函数"></a>2.1.1 简单的函数</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br><span class="line">19</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Function 转美金(x)<br>    转美金 = x / 6.03 - x * 0.03<br>End Function<br><br>Function 性别(str As String)<br>    If str = &quot;男&quot; Then<br>        性别 = &quot;先生&quot;<br>    ElseIf str = &quot;女&quot; Then<br>        性别 = &quot;女士&quot;<br>    End If<br>End Function<br><br>Function 日期转换(str As String)<br>    日期转换 = DateSerial(Left(str, 4), Mid(str, 5, 2), Right(str, 2))<br>End Function<br><br>Function 截取字符(str As String, str1 As String, i As Integer)<br>    截取字符 = Split(str, str1)(i - 1)<br>End Function<br></code></pre></div></td></tr></table></figure>

<h4 id="2-1-2-创建表通用过程"><a href="#2-1-2-创建表通用过程" class="headerlink" title="2.1.2 创建表通用过程"></a>2.1.2 创建表通用过程</h4><p><strong>创建表的过程</strong>。</p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 创建表(str As String)<br>Dim sht As Worksheet<br>&#x27; 表名重复，则k=1<br>For Each sht In Sheets<br>    If sht.Name = str Then<br>        k = 1<br>    End If<br>Next<br>&#x27; 表名不重复，则新建表<br>If k = 0 Then<br>    Sheets.Add after:=Sheets(Sheets.Count)<br>    Sheets(Sheets.Count).Name = str<br>End If<br><br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="2-1-3-加载宏"><a href="#2-1-3-加载宏" class="headerlink" title="2.1.3 加载宏"></a>2.1.3 加载宏</h4><ul>
<li>将有代码的工作簿存为<code>.xla</code>为后缀的文件，存放文档地点默认，即可保存为加载宏。</li>
<li>直接点击加载项就可以调用。</li>
<li>以后每次打开新的工作簿都可以调用此代码。</li>
</ul>
<h3 id="2-2-合并多个文件"><a href="#2-2-合并多个文件" class="headerlink" title="2.2 合并多个文件"></a>2.2 合并多个文件</h3><h4 id="2-2-1-对象赋值给变量"><a href="#2-2-1-对象赋值给变量" class="headerlink" title="2.2.1 对象赋值给变量"></a>2.2.1 对象赋值给变量</h4><p>Set的用法</p>
<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 对象赋值给变量()<br>Dim i As Integer<br>Dim sht As Worksheet<br>For i = 2 To 5<br>    &#x27; 用set将对象赋值给变量<br>    Set sht = Sheets.Add<br>    sht.Name = Sheet1.Range(&quot;a&quot; &amp; i)<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="2-2-2-Dir，路径的使用"><a href="#2-2-2-Dir，路径的使用" class="headerlink" title="2.2.2 Dir，路径的使用"></a>2.2.2 Dir，路径的使用</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub dir的用法()<br>Dim i As Integer<br>For i = 1 To 5<br>    &#x27; dir有则返回文件名，无则返回空值;*为通配符，xlsx，xls都可以<br>    &#x27; 若有n个文件符合，第一个dir加路径返回第一个值，第二个dir直接返回第二个值，<br>    &#x27; 到第n+1个dir返回空值，n+2个dir返回错误<br>    If Dir(&quot;d:\data\&quot; &amp; Range(&quot;a&quot; &amp; i) &amp; &quot;.xls*&quot;) = &quot;&quot; Then<br>        Range(&quot;b&quot; &amp; i) = &quot;无此文件&quot;<br>    Else<br>        Range(&quot;b&quot; &amp; i) = &quot;有文件&quot;<br>    End If<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br><span class="line">19</span><br><span class="line">20</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 遍历指定文件夹的文件()<br>Dim str As String<br>Dim wb As Workbook<br>str = Dir(&quot;d:\data\*.xls*&quot;)<br>For i = 1 To 100<br>    &#x27; 遍历打开指定文件夹内的所有xls*文件<br>    Set wb = Workbooks.Open(&quot;d:\data\&quot; &amp; str)<br><br>    &#x27; 这里该干嘛干嘛<br>    <br>    &#x27; 关闭打开的工作簿<br>    wb.Close<br>    &#x27; dir不带参数，返回下一个符合的文件名<br>    str = Dir<br>    &#x27; dir返回空，则下一个dir会出错，所有需要跳出循环<br>    If Dir = &quot;&quot; Then<br>        Exit For<br>    End If<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="2-2-3-多文件合并"><a href="#2-2-3-多文件合并" class="headerlink" title="2.2.3 多文件合并"></a>2.2.3 多文件合并</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br><span class="line">19</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 多文件合并()<br>Dim str As String<br>Dim wb As Workbook<br>Dim sht As Worksheet<br>str = Dir(&quot;d:\data\*.xls*&quot;)<br>For i = 1 To 100<br>    Set wb = Workbooks.Open(&quot;d:\data\&quot; &amp; str)<br>    For Each sht In wb.Sheets<br>        &#x27; 存放在当前活动工作薄的最后一张表<br>        sht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)<br>        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(wb.Name, &quot;.&quot;)(0) &amp; &quot;_&quot; &amp; sht.Name<br>    Next<br>    wb.Close<br>    str = Dir<br>    If str = &quot;&quot; Then<br>        Exit For<br>    End If<br>Next<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h4 id="2-2-4-查找的标准化写法"><a href="#2-2-4-查找的标准化写法" class="headerlink" title="2.2.4 查找的标准化写法"></a>2.2.4 查找的标准化写法</h4><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 使用查找功能()<br>&#x27; find标准化写法，否则找不到会报错<br>Dim rng As Range<br>&#x27; find返回一个单元格，赋值于对象<br>Set rng = Range(&quot;d:d&quot;).Find(Range(&quot;l3&quot;))<br>&#x27; 否否得有，为有数据<br>If Not rng Is Nothing Then<br>    Range(&quot;m3&quot;) = rng.Offset(0, 3)<br>End If<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h3 id="2-3-VBA数组"><a href="#2-3-VBA数组" class="headerlink" title="2.3 VBA数组"></a>2.3 VBA数组</h3><figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 使用数组提升运行效率()<br>Dim i, k<br>Dim t<br>Dim str As String<br>Dim arr()<br>&#x27; 用timer计算程序运行时间<br>t = Timer<br>&#x27; 数组<br>arr() = Range(&quot;g1:j200000&quot;)<br>str = Range(&quot;n5&quot;)<br>For i = 2 To 200000<br>    If arr(i, 1) = str Then<br>        k = k + arr(i, 4)<br>    End If<br>Next<br>Range(&quot;p5&quot;) = k<br>MsgBox Timer - t<br>End Sub<br></code></pre></div></td></tr></table></figure>

<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 小示例()<br>Dim arr()<br>Dim j, i As Integer<br>j = Range(&quot;a65536&quot;).End(xlUp).Row - 1<br>&#x27; 重新定义用ReDim<br>ReDim arr(1 To j)<br><br>For i = 1 To j<br>    arr(i) = Range(&quot;b&quot; &amp; i + 1) * Range(&quot;c&quot; &amp; i + 1)<br>Next<br>&#x27; 用自带的函数要加WorksheetFunction.<br>Range(&quot;h3&quot;) = Application.WorksheetFunction.Max(arr)<br>&#x27; Match用于返回一个值在指定数组中的位置<br>Range(&quot;h2&quot;) = Range(&quot;a&quot; &amp; Application.WorksheetFunction.Match(Range(&quot;h3&quot;), arr, 0) + 1)<br>&#x27; UBound返回数组上限和LBound下限<br>MsgBox LBound(arr)<br>End Sub<br></code></pre></div></td></tr></table></figure>

<figure class="highlight plaintext"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br><span class="line">19</span><br><span class="line">20</span><br><span class="line">21</span><br><span class="line">22</span><br><span class="line">23</span><br><span class="line">24</span><br><span class="line">25</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VBA">Sub 排列组合计算4个数相加等于124704()<br>Dim i, j, k, l As Integer<br>Dim arr()<br>t = Timer<br>arr = Range(&quot;a1:a80&quot;)<br>For i = 2 To 80<br>    For j = 2 To 80<br>        For k = 2 To 80<br>            For l = 2 To 80<br>                If arr(i, 1) + arr(j, 1) + arr(k, 1) + arr(l, 1) = 124704 Then<br>                    Range(&quot;f3&quot;) = arr(i, 1)<br>                    Range(&quot;g3&quot;) = arr(j, 1)<br>                    Range(&quot;h3&quot;) = arr(k, 1)<br>                    Range(&quot;i3&quot;) = arr(l, 1)<br>                    &#x27; 找到就用goto跳出循环<br>                    GoTo 100<br>                End If<br>            Next<br>        Next<br>    Next<br>Next<br><br>100<br>MsgBox Format(Timer - t, &quot;0.00000&quot;)<br>End Sub<br></code></pre></div></td></tr></table></figure>

<h3 id="2-4-使用ActiveX控件"><a href="#2-4-使用ActiveX控件" class="headerlink" title="2.4 使用ActiveX控件"></a>2.4 使用ActiveX控件</h3><h3 id="2-5-批量插入图片"><a href="#2-5-批量插入图片" class="headerlink" title="2.5 批量插入图片"></a>2.5 批量插入图片</h3><figure class="highlight vb"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br><span class="line">17</span><br><span class="line">18</span><br><span class="line">19</span><br><span class="line">20</span><br><span class="line">21</span><br><span class="line">22</span><br><span class="line">23</span><br><span class="line">24</span><br><span class="line">25</span><br><span class="line">26</span><br><span class="line">27</span><br><span class="line">28</span><br><span class="line">29</span><br><span class="line">30</span><br><span class="line">31</span><br><span class="line">32</span><br><span class="line">33</span><br><span class="line">34</span><br><span class="line">35</span><br><span class="line">36</span><br><span class="line">37</span><br><span class="line">38</span><br><span class="line">39</span><br><span class="line">40</span><br><span class="line">41</span><br><span class="line">42</span><br><span class="line">43</span><br><span class="line">44</span><br><span class="line">45</span><br><span class="line">46</span><br><span class="line">47</span><br><span class="line">48</span><br><span class="line">49</span><br><span class="line">50</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs VB"><span class="hljs-keyword">Public</span> <span class="hljs-keyword">Sub</span> 批量插入图片()<br><br><span class="hljs-comment">&#x27;开始插入图片前，需要将图片名字的跟单元格内容一致</span><br>    Application.ScreenUpdating = <span class="hljs-literal">False</span><br><span class="hljs-keyword">Dim</span> PicName$, pand&amp;, k&amp;, PicPath, i, p, n, PicArr, TitleRow<br><span class="hljs-keyword">Dim</span> PicNameCol, PicPath2, PicPath3, TPnameCol, TPCol<br>    <span class="hljs-keyword">Set</span> PicNameCol = Application.InputBox(<span class="hljs-string">&quot;请选择图片名称所在列，只能选择单列单元格！&quot;</span>, Title:=<span class="hljs-string">&quot;图片名称所在列&quot;</span>, Type:=<span class="hljs-number">8</span>)<br>        <span class="hljs-comment">&#x27;选择的图片名称所在列</span><br>    PicCol = PicNameCol.Column <span class="hljs-comment">&#x27;取图片名称所在列列列标</span><br>    <br>    <span class="hljs-keyword">Set</span> TPnameCol = Application.InputBox(<span class="hljs-string">&quot;请选择图片需要放置的列，只能选择单列单元格！&quot;</span>, Title:=<span class="hljs-string">&quot;图片所在列&quot;</span>, Type:=<span class="hljs-number">8</span>)<br>        <span class="hljs-comment">&#x27;选择的图片所在列</span><br>    TPCol = TPnameCol.Column <span class="hljs-comment">&#x27;取图片所在列列列标</span><br>    <br>    TitleRow = Val(Application.InputBox(<span class="hljs-string">&quot;请输入标题行的行数。&quot;</span>)) <span class="hljs-comment">&#x27;用户设置总表的标题行数</span><br>    <span class="hljs-keyword">If</span> TitleRow &lt; <span class="hljs-number">0</span> <span class="hljs-keyword">Then</span> MsgBox <span class="hljs-string">&quot;标题行必须大于等于零，请重新确认? &quot;</span>: <span class="hljs-keyword">Exit</span> <span class="hljs-keyword">Sub</span><br>    <br>    <span class="hljs-keyword">With</span> Application.FileDialog(msoFileDialogFolderPicker)<br>        .AllowMultiSelect = <span class="hljs-literal">False</span> <span class="hljs-comment">&#x27;禁止多选文件夹</span><br>       <span class="hljs-keyword">If</span> .Show <span class="hljs-keyword">Then</span> PicPath = .SelectedItems(<span class="hljs-number">1</span>) <span class="hljs-keyword">Else</span>: <span class="hljs-keyword">Exit</span> <span class="hljs-keyword">Sub</span><br>    <span class="hljs-keyword">End</span> <span class="hljs-keyword">With</span><br>    <span class="hljs-keyword">If</span> Right(PicPath, <span class="hljs-number">1</span>) &lt;&gt; <span class="hljs-string">&quot;\&quot;</span> <span class="hljs-keyword">Then</span> PicPath = PicPath &amp; <span class="hljs-string">&quot;\&quot;</span><br><br>    PicArr = Array(<span class="hljs-string">&quot;.jpg&quot;</span>, <span class="hljs-string">&quot;.jpeg&quot;</span>, <span class="hljs-string">&quot;.bmp&quot;</span>, <span class="hljs-string">&quot;.png&quot;</span>, <span class="hljs-string">&quot;.gif&quot;</span>) <span class="hljs-comment">&#x27;假定图片格式有5种</span><br>    <span class="hljs-keyword">For</span> i = TitleRow + <span class="hljs-number">1</span> <span class="hljs-keyword">To</span> Cells(Rows.Count, PicCol).<span class="hljs-keyword">End</span>(<span class="hljs-number">3</span>).Row<br>        PicPath2 = PicPath<br>        <span class="hljs-comment">&#x27; 图片名字，可自行更改</span><br>        PicName = Cells(i, PicCol).Value<br>        <span class="hljs-keyword">If</span> Len(PicName) &lt;&gt; <span class="hljs-number">0</span> <span class="hljs-keyword">Then</span> <span class="hljs-comment">&#x27;如果PicName不为空</span><br>            PicPath3 = PicPath2 &amp; PicName<br>            pand = <span class="hljs-number">0</span><br>            <span class="hljs-keyword">For</span> p = <span class="hljs-number">0</span> <span class="hljs-keyword">To</span> UBound(PicArr)<span class="hljs-comment">&#x27;UBound取数组最大下标</span><br>                <span class="hljs-keyword">If</span> Len(Dir(PicPath3 &amp; PicArr(p))) <span class="hljs-keyword">Then</span> <span class="hljs-comment">&#x27;如果picpath路径下存在PicName图片</span><br>                    ActiveSheet.Shapes.AddPicture PicPath3 &amp; PicArr(p), <span class="hljs-literal">True</span>, <span class="hljs-literal">True</span>, _<br>                    Cells(i, TPCol).Left + <span class="hljs-number">2</span>, Cells(i, TPCol).Top + <span class="hljs-number">1</span>, _<br>                    Cells(i, TPCol).Width - <span class="hljs-number">4</span>, Cells(i, TPCol).Height -<span class="hljs-number">2</span><span class="hljs-comment">&#x27;left、Width设置跟单元格左右两边的距离</span><br>                    pand = <span class="hljs-number">1</span><br>                    n = n + <span class="hljs-number">1</span><br>                <span class="hljs-keyword">End</span> <span class="hljs-keyword">If</span><br>            <span class="hljs-keyword">Next</span><br>            <span class="hljs-keyword">If</span> pand = <span class="hljs-number">0</span> <span class="hljs-keyword">Then</span> k = k + <span class="hljs-number">1</span><br>            <span class="hljs-keyword">End</span> <span class="hljs-keyword">If</span><br>    <span class="hljs-keyword">Next</span><br>    Application.ScreenUpdating = <span class="hljs-literal">True</span><br>    <span class="hljs-keyword">If</span> k &lt;&gt; <span class="hljs-number">0</span> <span class="hljs-keyword">Then</span><br>        MsgBox <span class="hljs-string">&quot;图片插入完成！共有&quot;</span> &amp; k &amp; <span class="hljs-string">&quot;张图片未找到，请重新确认源文件! &quot;</span><br>    <span class="hljs-keyword">Else</span><br>        MsgBox <span class="hljs-string">&quot;所有图片插入完成！&quot;</span><br>    <span class="hljs-keyword">End</span> <span class="hljs-keyword">If</span><br><span class="hljs-keyword">End</span> <span class="hljs-keyword">Sub</span><br></code></pre></div></td></tr></table></figure>

<h3 id="2-6-自动按回车"><a href="#2-6-自动按回车" class="headerlink" title="2.6 自动按回车"></a>2.6 自动按回车</h3><figure class="highlight vb"><table><tr><td class="gutter hljs"><div class="hljs code-wrapper"><pre><span class="line">1</span><br><span class="line">2</span><br><span class="line">3</span><br><span class="line">4</span><br><span class="line">5</span><br><span class="line">6</span><br><span class="line">7</span><br><span class="line">8</span><br><span class="line">9</span><br><span class="line">10</span><br><span class="line">11</span><br><span class="line">12</span><br><span class="line">13</span><br><span class="line">14</span><br><span class="line">15</span><br><span class="line">16</span><br></pre></div></td><td class="code"><div class="hljs code-wrapper"><pre><code class="hljs vb"><span class="hljs-keyword">Sub</span> 自动按回车()<br>    <span class="hljs-keyword">Dim</span> Number, i <span class="hljs-keyword">As</span> <span class="hljs-type">Integer</span><br>    Application.DisplayAlerts = <span class="hljs-literal">False</span><br>    <br>    Number = InputBox(<span class="hljs-string">&quot;请输入次数&quot;</span>) * <span class="hljs-number">3</span> + <span class="hljs-number">3</span><br>    <br>    <span class="hljs-keyword">For</span> i = <span class="hljs-number">1</span> <span class="hljs-keyword">To</span> Number<br>        SendKeys <span class="hljs-string">&quot;&#123;Enter&#125;&quot;</span><br>        t = Now + TimeValue(<span class="hljs-string">&quot;00:00:02&quot;</span>)<br>        <span class="hljs-keyword">Do</span> <span class="hljs-keyword">Until</span> Now &gt; t<br>        DoEvents<br>        <span class="hljs-keyword">Loop</span><br>    <span class="hljs-keyword">Next</span><br>    Application.DisplayAlerts = <span class="hljs-literal">True</span><br><br><span class="hljs-keyword">End</span> <span class="hljs-keyword">Sub</span><br></code></pre></div></td></tr></table></figure>



<h2 id="参考"><a href="#参考" class="headerlink" title="参考"></a>参考</h2><p><a target="_blank" rel="noopener" href="https://www.bilibili.com/video/BV1L4411Q7Ni">跟着王老师学Excel_VBA</a></p>

            </div>
            <hr>
            <div>
              <div class="post-metas mb-3">
                
                  <div class="post-meta mr-3">
                    <i class="iconfont icon-category"></i>
                    
                      <a class="hover-with-bg" href="/categories/%E8%AF%BB%E4%B9%A6%E7%AC%94%E8%AE%B0/">读书笔记</a>
                    
                      <a class="hover-with-bg" href="/categories/%E8%AF%BB%E4%B9%A6%E7%AC%94%E8%AE%B0/VB/">VB</a>
                    
                  </div>
                
                
                  <div class="post-meta">
                    <i class="iconfont icon-tags"></i>
                    
                      <a class="hover-with-bg" href="/tags/VBA/">VBA</a>
                    
                  </div>
                
              </div>
              
                <p class="note note-warning">
                  
                    本博客所有文章除特别声明外，均采用 <a target="_blank" href="https://creativecommons.org/licenses/by-sa/4.0/deed.zh" rel="nofollow noopener noopener">CC BY-SA 4.0 协议</a> ，转载请注明出处！
                  
                </p>
              
              
                <div class="post-prevnext">
                  <article class="post-prev col-6">
                    
                    
                      <a href="/2021/06/20/%E8%AF%BB%E4%B9%A6%E7%AC%94%E8%AE%B0/Linux/Linux%E5%91%BD%E4%BB%A4%E9%80%9F%E6%9F%A5%E5%A4%87%E5%BF%98%E6%89%8B%E5%86%8C/">
                        <i class="iconfont icon-arrowleft"></i>
                        <span class="hidden-mobile">Linux命令速查备忘手册</span>
                        <span class="visible-mobile">上一篇</span>
                      </a>
                    
                  </article>
                  <article class="post-next col-6">
                    
                    
                      <a href="/2021/01/06/games/%E4%BC%A0%E5%A5%87SF%E6%90%AD%E5%BB%BA/">
                        <span class="hidden-mobile">传奇SF搭建</span>
                        <span class="visible-mobile">下一篇</span>
                        <i class="iconfont icon-arrowright"></i>
                      </a>
                    
                  </article>
                </div>
              
            </div>

            
              <!-- Comments -->
              <article class="comments" id="comments" lazyload>
                
                  
                
                
  <div id="valine"></div>
  <script type="text/javascript">
    Fluid.utils.loadComments('#valine', function() {
      Fluid.utils.createScript('https://cdn.jsdelivr.net/npm/valine@1.4.14/dist/Valine.min.js', function () {
        new Valine({
          el: "#valine",
          app_id: "YzLqNtMw1YEwwACli1FUsIUM-gzGzoHsz",
          app_key: "HLUt5izfTvTcbEbOrA59W92a",
          placeholder: "畅所欲言...",
          path: window.location.pathname,
          avatar: "robohash",
          meta: ["nick","mail","link"],
          pageSize: "10",
          lang: "zh-CN",
          highlight: true,
          recordIP: false,
          serverURLs: "",
        });
      });
    });
  </script>
  <noscript>Please enable JavaScript to view the comments</noscript>


              </article>
            
          </article>
        </div>
      </div>
    </div>
    
      <div class="d-none d-lg-block col-lg-2 toc-container" id="toc-ctn">
        <div id="toc">
  <p class="toc-header"><i class="iconfont icon-list"></i>&nbsp;目录</p>
  <div class="toc-body" id="toc-body"></div>
</div>

      </div>
    
  </div>
</div>

<!-- Custom -->

  <div class="col-lg-7 mx-auto nopadding-x-md">
    <div class="container custom post-custom mx-auto">
      <img src="https://closer_laps.coding.net/p/picture/d/picture/git/raw/master/pay/pay.png" srcset="/img/loading.gif" lazyload class="rounded mx-auto d-block mt-3" style="width:355.4px; height:200px;">
    </div>
  </div>


    

    
      <a id="scroll-top-button" href="#" role="button">
        <i class="iconfont icon-arrowup" aria-hidden="true"></i>
      </a>
    

    
      <div class="modal fade" id="modalSearch" tabindex="-1" role="dialog" aria-labelledby="ModalLabel"
     aria-hidden="true">
  <div class="modal-dialog modal-dialog-scrollable modal-lg" role="document">
    <div class="modal-content">
      <div class="modal-header text-center">
        <h4 class="modal-title w-100 font-weight-bold">搜索</h4>
        <button type="button" id="local-search-close" class="close" data-dismiss="modal" aria-label="Close">
          <span aria-hidden="true">&times;</span>
        </button>
      </div>
      <div class="modal-body mx-3">
        <div class="md-form mb-5">
          <input type="text" id="local-search-input" class="form-control validate">
          <label data-error="x" data-success="v"
                 for="local-search-input">关键词</label>
        </div>
        <div class="list-group" id="local-search-result"></div>
      </div>
    </div>
  </div>
</div>
    

    
  </main>

  <footer class="text-center mt-5 py-3">
  <div class="footer-content">
     <a href="https://hexo.io" target="_blank" rel="nofollow noopener"><span>Hexo</span></a> <i class="iconfont icon-love"></i> <a href="https://github.com/fluid-dev/hexo-theme-fluid" target="_blank" rel="nofollow noopener"><span>Fluid</span></a> 
  </div>
  
  <div class="statistics">
    
    

    
      
        <!-- LeanCloud 统计PV -->
        <span id="leancloud-site-pv-container" style="display: none">
            总访问量 
            <span id="leancloud-site-pv"></span>
             次
          </span>
      
      
        <!-- LeanCloud 统计UV -->
        <span id="leancloud-site-uv-container" style="display: none">
            总访客数 
            <span id="leancloud-site-uv"></span>
             人
          </span>
      

    
  </div>


  
  <!-- 备案信息 -->
  <div class="beian">
    <span>
      <a href="http://beian.miit.gov.cn/" target="_blank" rel="nofollow noopener">
        苏ICP备20032307号
      </a>
    </span>
    
      
        <span>
          <a
            href="http://www.beian.gov.cn/portal/registerSystemInfo?recordcode=32020602001023"
            rel="nofollow noopener"
            class="beian-police"
            target="_blank"
          >
            
              <span style="visibility: hidden; width: 0">|</span>
              <img src="/img/police_beian.png" srcset="/img/loading.gif" lazyload alt="police-icon"/>
            
            <span>苏公网安备 32020602001023号</span>
          </a>
        </span>
      
    
  </div>


  
</footer>


  <!-- SCRIPTS -->
  
  <script  src="https://cdn.jsdelivr.net/npm/nprogress@0.2.0/nprogress.min.js" ></script>
  <link  rel="stylesheet" href="https://cdn.jsdelivr.net/npm/nprogress@0.2.0/nprogress.min.css" />

  <script>
    NProgress.configure({"showSpinner":false,"trickleSpeed":100})
    NProgress.start()
    window.addEventListener('load', function() {
      NProgress.done();
    })
  </script>


<script  src="https://cdn.jsdelivr.net/npm/jquery@3.6.0/dist/jquery.min.js" ></script>
<script  src="https://cdn.jsdelivr.net/npm/bootstrap@4.5.3/dist/js/bootstrap.min.js" ></script>
<script  src="/js/events.js" ></script>
<script  src="/js/plugins.js" ></script>

<!-- Plugins -->


  
    <script  src="/js/img-lazyload.js" ></script>
  



  



  <script  src="https://cdn.jsdelivr.net/npm/tocbot@4.12.2/dist/tocbot.min.js" ></script>



  <script  src="https://cdn.jsdelivr.net/npm/@fancyapps/fancybox@3.5.7/dist/jquery.fancybox.min.js" ></script>



  <script  src="https://cdn.jsdelivr.net/npm/anchor-js@4.3.0/anchor.min.js" ></script>



  <script defer src="https://cdn.jsdelivr.net/npm/clipboard@2.0.8/dist/clipboard.min.js" ></script>




  <script defer src="/js/leancloud.js" ></script>



  <script  src="https://cdn.jsdelivr.net/npm/typed.js@2.0.11/lib/typed.min.js" ></script>
  <script>
    (function (window, document) {
      var typing = Fluid.plugins.typing;
      var title = document.getElementById('subtitle').title;
      
      typing(title)
      
    })(window, document);
  </script>



  <script  src="/js/local-search.js" ></script>
  <script>
    (function () {
      var path = "/local-search.xml";
      $('#local-search-input').on('click', function() {
        searchFunc(path, 'local-search-input', 'local-search-result');
      });
      $('#modalSearch').on('shown.bs.modal', function() {
        $('#local-search-input').focus();
      });
    })()
  </script>





  

  
    <!-- MathJax -->
    <script>
      MathJax = {
        tex: {
          inlineMath: [['$', '$'], ['\\(', '\\)']]
        },
        options: {
          renderActions: {
            findScript: [10, doc => {
              document.querySelectorAll('script[type^="math/tex"]').forEach(node => {
                const display = !!node.type.match(/; *mode=display/);
                const math = new doc.options.MathItem(node.textContent, doc.inputJax[0], display);
                const text = document.createTextNode('');
                node.parentNode.replaceChild(text, node);
                math.start = { node: text, delim: '', n: 0 };
                math.end = { node: text, delim: '', n: 0 };
                doc.math.push(math);
              });
            }, '', false],
            insertedScript: [200, () => {
              document.querySelectorAll('mjx-container').forEach(node => {
                let target = node.parentNode;
                if (target.nodeName.toLowerCase() === 'li') {
                  target.parentNode.classList.add('has-jax');
                }
              });
            }, '', false]
          }
        }
      };
    </script>

    <script async src="https://cdn.jsdelivr.net/npm/mathjax@3.1.2/es5/tex-svg.js" ></script>

  








  
    <!-- Baidu Analytics -->
    <script defer>
      var _hmt = _hmt || [];
      (function () {
        var hm = document.createElement("script");
        hm.src = "https://hm.baidu.com/hm.js?608f2baddd361128381ad2bf9377bf89";
        var s = document.getElementsByTagName("script")[0];
        s.parentNode.insertBefore(hm, s);
      })();
    </script>
  

  

  

  

  

  





<!-- 主题的启动项 保持在最底部 -->
<script  src="/js/boot.js" ></script>


</body>
</html>
